;;; -*-LISP-*-


(eval-when (compile) (load "ps:<scheme.development>umacro"))
(eval-when (compile) (load "<scheme.development>smacro"))
(eval-when (compile)			;Used in DEFCONT-WITH-FORCED-VAL 
  (DEFUN CONCAT N
    (LET ((L (LISTIFY N)))
      (COND ((< (LENGTH L) 2)
	     (CAR L))
	    (T
	     (IMPLODE (MAPCAN 'EXPLODEC L)))))))

(DEFVAR *SAVED-PC* NIL)
(DEFVAR *BROKEN-PC-NAME* NIL)

(DEFCONT MICROCODE-BREAK ()
  (PRINT (SUBR (MAKNUM *SAVED-PC*)))
  (PRINC "Broken!")
  (*THROW 'DONE (FETCH VAL)))

(DEFMACRO BREAK-AT (PC)
  `(COND ((OR *SAVED-PC* *BROKEN-PC-NAME*)
	  (PRINT (SUBR (MAKNUM *SAVED-PC*)))
	  (PRINC "PC not restored"))
	 (T
	  (SETQ *SAVED-PC* ,PC)
	  (SETQ *BROKEN-PC-NAME* ',PC)
	  (SETQ ,PC MICROCODE-BREAK))))

(DEFUN UNBREAK ()
  (SET *BROKEN-PC-NAME* *SAVED-PC*)
  (SETQ *SAVED-PC* NIL)
  (SETQ *BROKEN-PC-NAME* NIL))

(DEFUN PROCEED ()
  (SUBRCALL NIL *SAVED-PC*)
  (SPIN-THE-WHEELS))